Simulation 5 - example 2

Sequential design with early stopping (restricted action set) - risk based

Published

May 8, 2025

Modified

May 6, 2025

Load simulation results
# Each input file corresponds to the results from a single simulation
# scenario/configuration.
# Load all the files into a single list.

# files of interest
sim_lab <- "sim05-13"
# files of interest
flist <- list.files(paste0("data/", sim_lab), pattern = "sim05")
toks <- list()
l <- list()
i <- 1
for(i in 1:length(flist)){
  l[[i]] <- qs::qread(file.path(paste0("data/", sim_lab), flist[i]))
  toks[[i]] <-  unlist(tstrsplit(flist[i], "[-.]"))
}

Results from example trial

The results are from a simulated trial picked from scenario 4 where there is a moderate (OR 1.75) surgical revision effect in the two-stage domain only and all other domains having null treatment effects.

Table 1 shows the decisions made for each domain (or indeterminate if no decisions were made).

Code
g_tbl <- d_decision |> 
  gt() |> 
  cols_align(
    columns = 1:2,
    align = "center"
  )  |> 
  cols_align(
    columns = 3,
    align = "right"
  )  |>
  cols_label(
    domain = "Domain",
    decision = "Decision",
    N = "Enrolment"
  ) |>
  tab_options(
    table.font.size = "70%"
  ) |>
  fmt_number(decimals = 3, drop_trailing_zeros = TRUE)

g_tbl
Domain Decision Enrolment
1 Futile (sup) 500
2 NI 500
3 Futile (sup) 1,000
4 Futile (sup) 2,000
Table 1: Trial decisions by domain

Figure 1 shows the knowledge transitions based on the decisions made for each domain by sample size up to the point where the trial was stopped either due to running out of resources or having addressed all the questions.

Initially, all domains start in an indeterminate state in that neither treatment arm is preferred. As the data accrues and analyses progresses, the knowledge state for each domain may transition to, superiority, non-inferiority or futility.

Code
p1 <- ggplot(d_dec_timeline, aes(x = N, y = decision)) +
  geom_point() +
  scale_y_discrete("", drop=FALSE) +
  facet_wrap(domain ~ question, labeller = label_both)

suppressWarnings(print(p1))
Figure 1: Decision timeline

Figure 2 through to Figure 5 show sample size for each domains.

Figure 6 and Figure 7 show the parameter estimates.

Note:

Parameter estimates will only be reported up until the simulated trial was stopped due to all questions having been answered.

Figure 8 shows the probability associated with each decision type for the randomised comparisons by domain and enrolment progression.

Note:

See example 1 for general explanation of plot.

Code
d_fig_1 <- copy(d_pr_dec)
d_fig_1[, quant := factor(quant, levels = c("sup", "sup_fut", "ni", "ni_fut"),
                           labels = c("Superior", "Superior (futile)", 
                                      "NI", "NI (futile)"))]
d_fig_2 <- copy(d_dec_thres)
d_fig_2[, quant := factor(quant, levels = c("sup", "sup_fut", "ni", "ni_fut"),
                           labels = c("Superior", "Superior (futile)",
                                      "NI", "NI (futile)"))]

d_fig_2 <- merge(
  d_fig_2, 
  unique(d_fig_1[, .(domain, quant, question)]),
  by = c("quant", "domain")
)


p1 <- ggplot(d_fig_1, aes(x = N, y = value)) +
  geom_point(aes(col=quant), position = position_dodge2(width = 100), size = 0.6) + 
  geom_linerange(aes(ymin = 0, ymax = value, col=quant), 
                 position = position_dodge2(width = 100), lwd = 0.25)+
  geom_hline(
    data = d_fig_2,
    aes(yintercept = threshold, col=quant), lwd = 0.25
  ) +
  scale_x_continuous("") +
  scale_y_continuous("Decision probability", breaks = seq(0, 1, by = 0.2)) +
  scale_color_discrete("") +
  facet_wrap(domain ~ question, labeller = label_both)

suppressWarnings(print(p1))
Figure 8: Probability decision summaries